MacWorld 1999 July/Macworld (1999-07).dmg/Shareware World/Info/For Developers/Mops 3.4.sea/Mops source/Module source/windowmod.txt

Text File | 1999-02-05 | 11KB | 437 lines

\ Window class.

\  May 91 mrh    Added NonScrollWind.
\    Default grow and drag limits set at grow and drag time.
\    Also fixed a number of long-standing bugs in draw:, enable:, disable:
\    etc.  New: deactivates current window.  Added PenIntoWind:.

\    Nov95 JRF    Option to not outline unused scroll bars


\        ===================================

\ WINDOW is the basic window class, with no controls.
\  For windows with controls, use Window+.

\        ===================================

:class    WINDOW  super{ grafPort }
68k_record
{    $ 20    bytes    wind1            \ unmapped
            handle    CTLLIST            \ 1st ctl
    $ 0C    bytes    wind2            \ unmapped

            rect    CONTRECT        \ true content
            rect    GROWRECT        \ grow size rectangle
            rect    DRAGRECT        \ drag limits rect

            bool    GROWFLG            \ true if growable
            bool    DRAGFLG            \ true if draggable
            bool    ALIVE            \ true if space exists
            bool    SCROLLFLG        \ true if scrollable
            bool    COLOR?            \ true if this is a color window

            x-addr    IDLE            \ idle handler
            x-addr    DEACT            \ deactivate event handler

            x-addr    CONTENT            \ content handler
            x-addr    DRAW            \ draw handler
            x-addr    ENACT            \ activate event handler
            x-addr    CLOSE            \ close handler

            int        RESID            \ resource id

            bool    ClipGrowLeft    \ Nov95 JRF Option to not outline unused HScroll
            bool    ClipGrowTop        \ ditto unused VScroll -- DrawGrowIcon normally

            rect    thefprect        \ 17Dec98 DBH - we now save fpRect here over
                                    \  a DRAW:, rather than in the stack which
                                    \  makes the Mops stack display look strange.
}
public
    ptr        ^view_in_focus            \ points to view which gets keys etc.

private

:m SETLIMITS:    \ Sets GrowRect and DragRect to reasonable default values
                \ according to the current screen size at the time the grow
                \ or drag is done.  Programs such as SteppingOut can change
                \ the screen size while a window is open!

    screenbits  put: dragRect
    40 40 getBot: dragRect  put: growRect
    4 4 inset: dragRect  ;m

:m ?SETFPRECT:    \ Sets fPrect if scrollFlg is true.  fPrect is needed by
                \ the nucleus for scrolling fWind, before proper window
                \ handling is loaded.  But it can be used for scrolling
                \ text in any other window as well, if scrolling is enabled
                \ for that window.

    get: scrollFlg IF  get: contRect  put: fPrect  THEN  ;m

:m ?DISABLE_ACTW:    \ Deactivates the currently active window before a New:
                    \ or GetNew: call, if there is a currently active Mops
                    \ window.
    ?disable_actw  0 -> actW  ;m

:m InitNewWindow:
    setContRect: [self]
    set: self  initfont  true  put: alive
    cls  ;m

:m PenIntoWind:    \ Moves the GrafPort pen back into the window area if
                \ necessary, after the window has been resized.
                \ Actually at the moment we only worry about the vertical
                \ direction.
    @xy bottom min  gotoxy  ;m

public

\ Grow icon methods:

:m SETCLIPGROWLEFT:    put: clipgrowleft ;m    \ Nov95 JRF
:m SETCLIPGROWTOP:    put: clipgrowtop ;m        \ Nov95 JRF

:m DRAWGROW:  { \ l t r b -- }                \ Nov95 JRF rev.
    get: growFlg  0EXIT
    get: clipgrowleft get: clipgrowtop OR
    NIF    noClip
        @xy   ^base  DrawGrowIcon
        gotoxy
        EXIT
    THEN
    getRect: self  -> b -> r -> t -> l
    get: clipgrowleft IF r 15 - ELSE 0 THEN
    get: clipgrowtop  IF b 15 - ELSE 0 THEN
    r b put: tempRect clip: tempRect
    @xy     ^base  DrawGrowIcon
    gotoxy  noClip  ;m


:m ERASEGROW:  { \ l t r b -- }
    get: growFlg  0EXIT
    noClip
    getRect: self  -> b -> r -> t -> l
    r 13 -  b 13 -  r  b  put: tempRect
    clear: tempRect  ;m



:m SETCONTRECT:    \ Sets ContRect to the viewing area.  Must be public since
                \ we late-bind to it, and it gets called from ObjInit anyway.

    get: portRect  get: growFlg
    IF  swap 15 -  swap  15 -  THEN   put: contRect
    ?setfPrect: self  ;m

:m CLOSE:
    get: alive  0EXIT
    ^base  CloseWindow
    ^base actW = IF  0 -> actW  THEN    \ If this was the active window, it
                                        \  isn't any more
    clear: alive   exec: close  ;m

:m RELEASE:    close: [self]  ;m    \ Standard destructor - same as close.

:m SET:        \ Makes this wind the current GrafPort.  It used
            \ to call setContRect: but there's really no need.
    set: super
    ?setfPrect: self  ;m

:m UPDATE:    \ Generates an update event for the window with its
            \  entire port rectangle as the update region.
    pushPort  set: self
    getRect: self  put: tempRect  update: tempRect
    popPort  ;m


:m NEW: { bndsRect tAddr tLen procID vis goAway \ s255 -- }

  \ Defines a new window on the heap with the specified features.
  \ Not resource based.

    get: alive  ?EXIT                \ Out if already alive
    bndsRect ->: contRect            \ save rect locally
    ?disable_actW: self
    tAddr tLen  str255  -> s255
    ^base  addr: contRect  s255
    vis 1 and
    procID
    inFront  goAway 1 and
    0                                \ default is initially in front
    get: color?
    IF  NewCWindow  ELSE  NewWindow  THEN  drop
    initNewWindow: self  ;m


:m GETNEW:        \ ( resid -- )   Resource based new window.

    get: alive  IF  drop  EXIT  THEN    \ Out if already alive
    ?disable_actW: self
    dup  put: resid  ^base  inFront
    get: color?
    IF    GetNewCWindow  ELSE  GetNewWindow  THEN  drop
    initNewWindow: self  ;m


:m GETVSRECT:    \ ( l t r b -- l' t' r' b' )
                \ Returns the default vert. scroll bar rect.
    get: portRect  >vrect  ;m

:m GETHSRECT:    \ ( l t r b -- l' t' r' b' )
                \ Returns the default horiz. scroll bar rect.
    get: portRect  >hrect  ;m


(*    The DRAW: method is called, late-bound, whenever a window is updated.
    The implementation must begin with a BeginUpdate call and end with an
    EndUpdate call.  We use the CallFirst/CallLast mechanism to ensure this,
    and also to draw the grow icon if this is a growable window.  This means
    that any redefinition of DRAW: in a subclass should not call DRAW: super,
    since this would lead to BeginUpdate and EndUpdate being called more than
    once.  So we define another method (DRAW): to do the actual work for DRAW:,
    and subclasses which need their own versions of DRAW: may call (DRAW):
    freely.
*)

private

:m (DRAW):        \ Does the main work for DRAW:.
    savePort  @xy  set: self    \ Save port and pen posn, reset to this
                                \  window
    exec: draw                    \ Call user draw routine
    restPort gotoxy                \ Restore pen posn, restore original port
;m

:m SETUP_DRAW:
    get: fPrect put: thefprect        \ 17Dec98 DBH - Save fPrect as it might get changed
    ^base  BeginUpdate
;m

:m WINDUP_DRAW:
    drawGrow: self
    ^base  EndUpdate
    get: thefprect put: fPrect        \ 17Dec98 DBH - Restore fPrect
;m

callFirst    setup_draw:
callLast    windup_draw:

public

:m DRAW:    (draw): self  ;m

:m SELECT:        \ Makes this the front window.
    ^base  SelectWindow
    ?setfPrect: self  ;m


(*    The idle: method is called for the frontmost window, whenever a null
    event occurs.  NULL-EVT is the normal word which sends idle:.  In
    subclasses we redefine this method to do things like calling TEidle,
    which have to be done periodically.  The Idle handler is also called,
    which allows a window-specific action to be taken.  In the class Window
    itself, this is all we do.
*)

:m IDLE:        exec: idle  ;m

:m SETIDLE:        put: idle  ;m


:m ENABLE:        \ Handles an activate event.
    set: self
    drawGrow: self
    exec: enact  ;m

:m DISABLE:        \ Handles a deactivate event.
    eraseGrow: self
    exec: deact  ;m


:m ACTIONS:        \ ( close enact draw cont 4 -- )
                \ Sets up window event handler words.  We require
                \ an xt count as this is normal for actions: methods.
    4 ?#xts
    put: content  put: draw  put: enact  put: close  ;m


:m SETACT:    \ ( enact deact -- )  Sets just the activate/deactivate
            \ event handlers
    put: deact  put: enact  ;m


:m SETDRAW:        \ ( xt -- )  Sets the draw handler
    put: draw  ;m


:m SETCOLOR:    \ ( b -- )  Sets the color? flag.
    put: color?  ;m


:m ACTIVE:    \ ( -- b )  Is this window active ?
    FrontWindow  ^base =  ;m


:m ALIVE:    \ ( -- b )  Is this window alive?
    get: alive  ;m


:m DRAG:    \ Handles a drag region click
    setLimits: self                    \ Omit in subclasses which need
                                    \  custom drag limits
    get: dragFlg  0EXIT
    ^base  whrFEv  addr: dragRect
    DragWindow  ;m

private

\ Some housekeeping routines for Size: and Zoom:

:m ClrOldBars:
    getVSrect: self 16 +  put: tempRect
    clear: tempRect  update: tempRect    \ Including the grow box
    getHSrect: self  put: tempRect
    clear: tempRect  update: temprect  ;m

:m FixNewBars:
    ClrOldBars: self                    \ Yes, the code's the same so far!!
    addr: portRect  ClipRect
    setContRect: [self]
    penIntoWind: self  ;m

public

:m SIZE:  { wid ht -- }    \ Resizes window and accumulates update regions.
    ^base  wid ht  true
    ClrOldBars: self
    SizeWindow
    FixNewBars: self  ;m

:m SETSIZE:    size: self  ;m    \ For naming consistency with Rects and
                            \  Views.


:m MOVE: { x y -- }        \ Moves the window.
    ^base x y
    0            \ don't bring to front - leave where it is
    MoveWindow  ;m


:m CENTER:  { \ sw sh pw ph -- }
        \ Centers the window on the screen.
        \ Yeah, I know, here in Oz we spell this "centre", but we Ozzies
        \ are more flexible than the Yanks, so we'll magnanimously do it
        \ their way, not ours.

    screenbits  -> sh  -> sw  2drop
    size: portRect  -> ph  -> pw
    sw pw - 2/  sh ph - 2/  move: self  ;m


:m ZOOM:  { part -- }
    ^base  whrFEv part TrackBox
    IF    getRect: self  put: tempRect  tempRect  EraseRect
        ^base  part 0  ZoomWindow
        FixNewBars: self
    THEN  ;m


:m GROW:        \ Handles a mouse-down in the grow box.
    get: growFlg
    IF    setLimits: self                    \ Omit in subclasses which need
                                        \  custom grow limits
        ^base  whrFEv  addr: growrect
        GrowWindow            \ returns a packed point, or 0
        ?dup
        IF    unpack ( wid ht )  size: self  ( draw: self )
            penIntoWind: self
        THEN
    ELSE
        ^base  SelectWindow
    THEN
    update: self  ;m


:m CONTENT:        \ Handles a content click.
    active: self
    IF        exec: content
    ELSE    select: self
    THEN  ;m


:m TITLE:    \ ( addr len -- )  Sets the title of the window.
    str255  ^base  swap  SetWTitle  ;m

:m NAME:  ( addr len -- )    title: self  ;m        \ An alias for TITLE:.


:m GETNAME:    \ ( -- addr len )  Returns name of window.
    ^base  buf255  GetWTitle
    buf255 count  ;m


:m MAXX:    \ ( -- x )  Returns the x coordinate value corresponding to
            \  the window being moved to the right of the screen.
    screenbits drop nip nip
    size: portRect  drop  -  ;m


:m MAXY:    \ ( -- y )
    screenbits nip nip nip
    size: portRect  nip  -  ;m

\            =================

:m KEY:        \ ( c -- )  May be used in subclasses to do something with
            \  typed keys.  Here, we just drop it.
    drop  ;m


:m SHOW:    ^base  ShowWindow  ;m

:m HIDE:    ^base  HideWindow  ;m


:m SETGROW:    \ ( l t r b  T  |  F -- )  Sets grow limits, if boolean is true.

    \ Note: in class Window itself, we IGNORE these grow limits and
    \  use a default value based on the size of the screen at the time
    \  the grow is actually done.

    dup  put: growFlg
    IF  put: growrect  THEN  ;m

:m SETDRAG:    \ ( l t r b  T  |  F -- )  Sets drag limits.

    \ Note: in class Window itself, we IGNORE these drag limits and
    \  use a default value based on the size of the screen at the time
    \  the drag is actually done.

    dup  put: dragFlg
    IF  put: dragRect  THEN  ;m

:m SETSCROLL:    \ ( b -- )
    put: scrollFlg  ;m


:m CLASSINIT:
    xts{ null null null null }  actions: self
    ['] null  dup  put: idle  put: deact
    true  put: scrollFlg  true  put: dragFlg  ;m


:m MARKALIVE:    \ A special method really intended just to allow us to
                \ mark fWind alive on startup.
    true  put: alive   ;m


:m TEST:        \ Fires up a test window.
    100 100 300 200 put: tempRect
    screenbits true setGrow: self
    tempRect  " Test"  docWind  true true  new: self  ;m

;class